كيفية تكبير الفورم بجميع محتوايتهRESIZE FORM

مغلق

بدأه hichamchak في 26 يوليو 2005 · 12 رد · 1,972 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات

مشاركة: واتساب X فيسبوك تيليجرام

#126 يوليو 2005 في 17:57 صاحب الموضوع

بسم الله الرحمن الرحيم

هذا مثال لتكبير الفورم بكل ما يحتويه من ازرار وغير ذالك (برمجيا)

مع الكود سورس

تم تعديل هذه المشاركة بواسطة hichamchak في 26 يوليو 2005 في 18:01

#226 يوليو 2005 في 18:23

مشكورا اخي hichamchak

مواضيع متنوعة

#326 يوليو 2005 في 20:34

جميل جدا اخي ..

لكن او وضعت هذا البرنامج في الموضوع المثبت معلومه كل يوم .. لكن افضل :) ..

أشهد أن لا إله إلا الله ***************** وأشهد أن محمد عبده ورسوله

#426 يوليو 2005 في 21:57

ANSI كتب:
جميل جدا اخي ..
لكن او وضعت هذا البرنامج في الموضوع المثبت معلومه كل يوم .. لكن افضل :) ..
←

شكرا لك اخي ANS

لقد سبقتنى ووضعته انت في معلومة كل يوم

اتمنى ان كل الاعضاء مثلك يحبون الخير لهذا المنتدى الرائع

#527 يوليو 2005 في 06:25

لا شكر على واجب اخي ....

الى الامام .. ازدنا من مشاركاتك الجميله في معلومه كل يوم ... :)

أشهد أن لا إله إلا الله ***************** وأشهد أن محمد عبده ورسوله

#627 يوليو 2005 في 14:00

السلام عليكم

مشكورا اخي hichamchak على الكود الرائع

لي طلب ارجو ان لا يزعجك

اريد هذا الكود يعمل على MDIform لاني حاولت ولم استطيع

ارجو المساعدة

وشكرا جزيلا اك ولكل الاخوة

#727 يوليو 2005 في 14:56

ابو بدران كتب:
السلام عليكم
مشكورا اخي hichamchak على الكود الرائع
لي طلب ارجو ان لا يزعجك
اريد هذا الكود يعمل على MDIform لاني حاولت ولم استطيع
ارجو المساعدة
وشكرا جزيلا اك ولكل الاخوة
←

شكرا لك ارجو ان هذالكود يفيدك

ضع هذا الكود في الفورم
Private Sub Form_Resize()
  ResizeForm Me
End Sub

هذا الكود في MODULES
Public Type ctrObj
  Name As String
  Index As Long
  Parrent As String
  Top As Long
  Left As Long
  Height As Long
  Width As Long
  ScaleHeight As Long
  ScaleWidth As Long
End Type

Private FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private bRunning As Boolean
Private MaxForm As Long
Private MaxControl As Long

Private Function ActualPos(plLeft As Long) As Long
  If plLeft < 0 Then
    ActualPos = plLeft + 75000
  Else
    ActualPos = plLeft
  End If
End Function

Private Function FindForm(pfrmIn As Form) As Long
  Dim i As Long
  
  FindForm = -1
  If MaxForm > 0 Then
    For i = 0 To (MaxForm - 1)
      If FormRecord(i).Name = pfrmIn.Name Then
        FindForm = i
        Exit Function
      End If
    Next i
  End If
End Function


Private Function AddForm(pfrmIn As Form) As Long
  Dim FormControl As Control
  Dim i As Long
  ReDim Preserve FormRecord(MaxForm + 1)

  FormRecord(MaxForm).Name = pfrmIn.Name
  FormRecord(MaxForm).Top = pfrmIn.Top
  FormRecord(MaxForm).Left = pfrmIn.Left
  FormRecord(MaxForm).Height = pfrmIn.Height
  FormRecord(MaxForm).Width = pfrmIn.Width
  FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight

  FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
  AddForm = MaxForm
  MaxForm = MaxForm + 1

  For Each FormControl In pfrmIn
    i = FindControl(FormControl, pfrmIn.Name)
    If i < 0 Then i = AddControl(FormControl, pfrmIn.Name)
  Next FormControl
End Function

Private Function FindControl(inControl As Control, inName As String) As Long
  Dim i As Long
  
  FindControl = -1
  For i = 0 To (MaxControl - 1)
    If ControlRecord(i).Parrent = inName Then
      If ControlRecord(i).Name = inControl.Name Then
        On Error Resume Next
        
        If ControlRecord(i).Index = inControl.Index Then
          FindControl = i
          Exit Function
        End If
        On Error GoTo 0
      
      End If
    End If
  Next i
End Function

Private Function AddControl(inControl As Control, inName As String) As Long
  ReDim Preserve ControlRecord(MaxControl + 1)
  On Error Resume Next
  
  ControlRecord(MaxControl).Name = inControl.Name
  ControlRecord(MaxControl).Index = inControl.Index
  ControlRecord(MaxControl).Parrent = inName

  If TypeOf inControl Is Line Then
    ControlRecord(MaxControl).Top = inControl.Y1
    ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
    ControlRecord(MaxControl).Height = inControl.Y2
    ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
  Else
    ControlRecord(MaxControl).Top = inControl.Top
    ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
    ControlRecord(MaxControl).Height = inControl.Height
    ControlRecord(MaxControl).Width = inControl.Width
  End If

  inControl.IntegralHeight = False
  
  On Error GoTo 0
  AddControl = MaxControl
  MaxControl = MaxControl + 1
End Function

Private Function PerWidth(pfrmIn As Form) As Long
  Dim i As Long
  
  i = FindForm(pfrmIn)
  If i < 0 Then i = AddForm(pfrmIn)
  
  PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth
End Function

Private Function PerHeight(pfrmIn As Form) As Single
  Dim i As Long
  
  i = FindForm(pfrmIn)
  If i < 0 Then i = AddForm(pfrmIn)
  
  PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight
End Function

Private Sub ResizeControl(inControl As Control, pfrmIn As Form)
  On Error Resume Next
  Dim i As Long
  Dim widthfactor As Single, heightfactor As Single
  Dim minFactor As Single
  Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
  
  yRatio = PerHeight(pfrmIn)
  xRatio = PerWidth(pfrmIn)
  i = FindControl(inControl, pfrmIn.Name)

  If inControl.Left < 0 Then
    lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
  Else
    lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
  End If

  lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
  lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
  lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)
  
  If TypeOf inControl Is Line Then
    If inControl.X1 < 0 Then
      inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
    Else
      inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
    End If
    
    inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)
    If inControl.X2 < 0 Then
      inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
    Else
      inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
    End If

    inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
  Else
    inControl.Move lLeft, lTop, lWidth, lHeight
    inControl.Move lLeft, lTop, lWidth
    inControl.Move lLeft, lTop
  End If
End Sub

Public Sub ResizeForm(pfrmIn As Form)
  Dim FormControl As Control
  Dim isVisible As Boolean
  Dim StartX, StartY, MaxX, MaxY As Long
  Dim bNew As Boolean
  
  If Not bRunning Then
    bRunning = True
    
    If FindForm(pfrmIn) < 0 Then
      bNew = True
    Else
      bNew = False
    End If

    If pfrmIn.Top < 30000 Then
      isVisible = pfrmIn.Visible
      On Error Resume Next
      
      If Not pfrmIn.MDIChild Then
        On Error GoTo 0
        'pfrmIn.Visible = False
      Else
        If bNew Then
          StartY = pfrmIn.Height
          StartX = pfrmIn.Width
          On Error Resume Next

          For Each FormControl In pfrmIn
            If FormControl.Left + FormControl.Width + 200 > MaxX Then _
              MaxX = FormControl.Left + FormControl.Width + 200
            If FormControl.Top + FormControl.Height + 500 > MaxY Then _
              MaxY = FormControl.Top + FormControl.Height + 500
            If FormControl.X1 + 200 > MaxX Then _
              MaxX = FormControl.X1 + 200
            If FormControl.Y1 + 500 > MaxY Then _
              MaxY = FormControl.Y1 + 500
            If FormControl.X2 + 200 > MaxX Then _
              MaxX = FormControl.X2 + 200
            If FormControl.Y2 + 500 > MaxY Then _
              MaxY = FormControl.Y2 + 500
          Next FormControl
          On Error GoTo 0
          
          pfrmIn.Height = MaxY
          pfrmIn.Width = MaxX
        End If
        On Error GoTo 0

      End If
      
      For Each FormControl In pfrmIn
        ResizeControl FormControl, pfrmIn
      Next FormControl
      On Error Resume Next

      If Not pfrmIn.MDIChild Then
        On Error GoTo 0
        pfrmIn.Visible = isVisible
      Else
        If bNew Then
          pfrmIn.Height = StartY
          pfrmIn.Width = StartX
          
          For Each FormControl In pfrmIn
            ResizeControl FormControl, pfrmIn
          Next FormControl
        End If
      End If
      On Error GoTo 0
      
    End If
    bRunning = False
  End If
End Sub

Public Sub SaveFormPosition(pfrmIn As Form)
  Dim i As Long

  If MaxForm > 0 Then
    For i = 0 To (MaxForm - 1)
      If FormRecord(i).Name = pfrmIn.Name Then
        FormRecord(i).Top = pfrmIn.Top
        FormRecord(i).Left = pfrmIn.Left
        FormRecord(i).Height = pfrmIn.Height
        FormRecord(i).Width = pfrmIn.Width
        Exit Sub
      End If
    Next i
    AddForm (pfrmIn)
  End If
End Sub

Public Sub RestoreFormPosition(pfrmIn As Form)
  Dim i As Long

  If MaxForm > 0 Then
    For i = 0 To (MaxForm - 1)
      If FormRecord(i).Name = pfrmIn.Name Then
        If FormRecord(i).Top < 0 Then
          pfrmIn.WindowState = 2
        ElseIf FormRecord(i).Top < 30000 Then
          pfrmIn.WindowState = 0
          pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height
        Else
          pfrmIn.WindowState = 1
        End If
        Exit Sub
      End If
    Next i
  End If
End Sub

#828 يوليو 2005 في 05:16

السلام عليكم

اخي hichamchak شكررررررررا جزيلا على المساعدة وجزاك الله الخير

اخي العزيز عند استعمال MDIForm لا نستطيع وضع اي زر إلا بعد ان نضع

PictureBox ثم نضع داخلة Command او اكثر وان استعمل هذه الطريقة

وعند استعمال الكود الذي وضعتة لا يكبر اي زر ولا يغير موقعة من الفورم

لذلك ارجو المساعدة لاهمية الموضوع

وانا انتظر الرد

شكرا جزززززززززززززززززززيلا

#928 يوليو 2005 في 14:23

اقتباس
وعند استعمال الكود الذي وضعتة لا يكبر اي زر ولا يغير موقعة من الفورم
لذلك ارجو المساعدة لاهمية الموضوع

الكود يعمل 100/100

هذا مثال مبرمج بالكود نفسه اتمنى ان تجد فيه ضالتك

اخبرنى اذا احتجت مساعدة

المثال

#1028 يوليو 2005 في 18:44

ٍالسلام عليكم

شكرا جزيلا على الرد وشكرا لهتمامك بالموضوع

اخي hichamchak الكود يعمل على الفورم العادية ولا يعل على MDIForm

ارجو عمل كود يعمل على MDIForm

ولك جزيل الشكرررررررررر

#1115 أكتوبر 2005 في 00:31

أعتقد أن الأداة المسماة Resizer XT تكفي وزيادة

فهي من أسهل ما يكون

وفيدة وخفيفة جدا

::::التوقيع::::

موقع ممتاز

وان شاء الله يفيد الجميع

وشكرا

؟؟لماذا لا يصل الايميل المرسل من صفحتي الي الهوتميل؟؟

مستوي الجدية في المواضيع المطروحة

لا اله الا الله محمد رسول الله

#1215 أكتوبر 2005 في 00:48

مشكور على الكود

اخي ashrafweb

كيف نحصل على الاداة المذكورة ؟

#1323 أكتوبر 2005 في 22:22

ResizerXTLite.zipthis is