working on it ...

Filters

snippets
520
followers
6
Published by snip2code

Pascal

This channel collects useful snippets for Pascal language
Sort by

Found 520 snippets

    public by snip2code modified Aug 13, 2017  129  0  3  1

    First Snippet: How to play with Snip2Code

    This is the first example of a snippet: - the title represents in few words which is the exact issue the snippet resolves; it can be something like the name of a method; - the description (this field) is an optional field where you can add interesting information regarding the snippet; something like the comment on the head of a method; - the c
    /* place here the actual content of your snippet. 
       It should be code or pseudo-code. 
       The less dependencies from external stuff, the better! */

    public by FMXExpress modified Nov 13, 2014  8993  90  7  1

    Non Blocking Message Dialog For Delphi XE7 Firemonkey

    MessageDlg(‘Do you want to press yes or no?’, System.UITypes.TMsgDlgType.mtInformation,
      [System.UITypes.TMsgDlgBtn.mbYes, System.UITypes.TMsgDlgBtn.mbNo], 0,
        procedure(const AResult: TModalResult)
        begin
          case AResult of
            { Detect which button was pushed and show a different message }
            mrYes:
                begin
                // pressed yes
                end;
            mrNo:
                begin
                // pressed no
                end;
          end;
        end
      );
    // code here would get executed right away

    public by FMXExpress modified Nov 12, 2014  7083  9  9  4

    Install A Shortcut On Android With Delphi XE5 Firemonkey

    http://www.fmxexpress.com/install-shortcuts-on-the-android-home-screen-with-delphi-xe5-firemonkey/
    //Android permission required:
    //<uses-permission android:name=”com.android.launcher.permission.INSTALL_SHORTCUT”/>
        
    Uses
    Androidapi.JNI.GraphicsContentViewText, FMX.Helpers.Android,
    Androidapi.JNI.JavaTypes, FMX.Platform.Android, AndroidApi.JniBridge, AndroidApi.Jni.App,
    AndroidAPI.jni.OS;
    
    {$IFDEF ANDROID}
    var
    ShortcutIntent: JIntent;
    addIntent: JIntent;
    wIconIdentifier : integer;
    wIconResource : JIntent_ShortcutIconResource;
    {$ENDIF}
    begin
    {$IFDEF ANDROID}
    
    ShortcutIntent := TJIntent.JavaClass.init(SharedActivityContext, SharedActivityContext.getClass);
    ShortcutIntent.setAction(TJIntent.JavaClass.ACTION_MAIN);
    
    addIntent := TJIntent.Create;
    addIntent.putExtra(TJIntent.JavaClass.EXTRA_SHORTCUT_INTENT, TJParcelable.Wrap((shortcutIntent as ILocalObject).GetObjectID));// here we need to cast the intent as it’s not done in delphi by default, not like java
    addIntent.putExtra(TJIntent.JavaClass.EXTRA_SHORTCUT_NAME, StringToJString(Application.Title));
    addIntent.setAction(StringToJString(‘com.android.launcher.action.INSTALL_SHORTCUT’));
    // get icon resource identifier
    wIconIdentifier := SharedActivity.getResources.getIdentifier(StringToJString(‘ic_launcher’), StringToJString(‘drawable’), StringToJString(‘com.embarcadero.HeaderFooterApplication’)); // if the app name change, you must change the package name
    wIconResource := TJIntent_ShortcutIconResource.JavaClass.fromContext(SharedActivityContext, wIconIdentifier);
    // set icon for shortcut
    addIntent.putExtra(TJIntent.JavaClass.EXTRA_SHORTCUT_ICON_RESOURCE, TJParcelable.Wrap((wIconResource as ILocalObject).GetObjectID));
    
    SharedActivityContext.sendBroadcast(addIntent);
    
    {$ENDIF}
     

    public by FMXExpress modified Nov 12, 2014  4188  17  6  1

    Decode GZIP Content From TRESTClient In Delphi XE7 Firemonkey

    RESTClient.AcceptEncoding := 'gzip, deflate';
    RESTClient.Execute;
    
    if RESTResponse.ContentEncoding=’gzip’ then
    DecodeGZIPContent(RESTResponse.RawBytes) // decode and do something with the content
    else
    RESTResponse.Content; // do something with the content
    
    function DecodeGZIPContent(RawBytes: System.TArray<System.Byte>): String;
    var
    MSI: TMemoryStream;
    MSO: TStringStream;
    begin
    MSI := TMemoryStream.Create;
    MSO := TStringStream.Create;
    MSI.WriteData(RawBytes,Length(RawBytes));
    MSI.Seek(0,0);
    // Zlib is a TIdCompressorZlib
    Zlib.DecompressGZipStream(MSI,MSO);
    MSI.DisposeOf;
    MSO.Seek(0,0);
    Result := MSO.DataString;
    MSO.Free;
    end;

    public by FMXExpress modified Nov 12, 2014  4641  2  7  1

    Process Strings Using A Parallel For Loop In Delphi XE7 Firemonkey

    TParallel.For(0,1000,
     procedure(I: Integer)
      begin
       TThread.Queue(TThread.CurrentThread,
        procedure
         begin
          Memo1.Lines.Append(I.ToString);
         end);
      end);

    external by Wellington Torrejais da Silva modified Thursday at 12:20:52 PM  3  0  1  0

    Teste Apply Updates Return

    Teste Apply Updates Return: test-apply-update.pas
    procedure TForm1.BitBtn1Click(Sender: TObject); //apply updates button
    var
    i: integer;
    begin
    SimpleDataSet1.Edit;
    SimpleDataSet1.FieldByName('SOME_FIELD').AsInteger := 1;
    SimpleDataSet1.Post;
    i := SimpleDataSet1.ApplyUpdates(-1);
    if i <> 0 then
       raise Exception.Create('Error count='+IntToStr(i)+' on ApplyUpdates occured');
    end; 
    
    

    external by Marcos Douglas B. Santos modified Monday at 2:35:33 AM  3  0  1  0

    Program 2, Performance and Interfaces

    Program 2, Performance and Interfaces: program2.pas
    program Project2;
    
    {$mode delphi}
    
    uses
      SysUtils, Unit1;
    
    procedure Execute(const A: IAction);
    begin
      A.Act;
    end;
    
    begin
      Execute(TAction.Create);
    end.
    
    
    

    external by Marcos Douglas B. Santos modified Monday at 2:22:15 AM  2  0  1  0

    Program 1, Performance and Interfaces

    Program 1, Performance and Interfaces: program1.pas
    program Project1;
    
    {$mode delphi}
    
    uses
      SysUtils, Unit1;
    
    procedure Execute(A: IAction);
    begin
      A.Act;
    end;
    
    var
      A: IAction;
    begin
      A := TAction.Create;
      Execute(A);
    end.
    
    
    

    external by Marcos Douglas B. Santos modified Monday at 12:34:41 AM  2  0  1  0

    Action, Performance, and const Args

    Action, Performance, and const Args: unit1.pas
    unit Unit1;
    
    {$mode delphi}
    
    interface
    
    uses
      Classes, SysUtils;
    
    type
      IAction = interface
        procedure Act;
      end;
    
      TAction = class(TInterfacedObject, IAction)
      protected
        function _AddRef: LongInt; stdcall;
        function _Release: LongInt; stdcall;
      public
        procedure Act;
        destructor Destroy; override;
      end;
    
    implementation
    
    { TAction }
    
    function TAction._AddRef: LongInt; stdcall;
    begin
      Result := inherited;
      Writeln('_AddRef called');
      Writeln('RefCount is ', fRefCount);
    end;
    
    function TAction._Release: LongInt; stdcall;
    begin
      Writeln('_Release called');
      Result := inherited;
    end;
    
    procedure TAction.Act;
    begin
      Writeln('Acting...');
    end;
    
    destructor TAction.Destroy;
    begin
      Writeln('RefCount is ', fRefCount);
      Writeln('Destroing...');
      inherited Destroy;
    end;
    
    end.
    
    
    

    external by Artgerto modified Dec 4, 2017  2  0  1  0

    Дана прямоугольная матрица A[K,N]. В четных строках с минимальной суммой элементов положительные элементы переместить в начало, отрицательные - в конец. В нечетных строках отрицательные четные элементы удвоить.

    Дана прямоугольная матрица A[K,N]. В четных строках с минимальной суммой элементов положительные элементы переместить в начало, отрицательные - в конец. В нечетных строках отрицательные четные элементы удвоить.: PascalKontr.pas
    var
      a: array [1..100, 1..100] Of integer;
      i, j, n, k, j1: integer;
      minsum, sum, currentPos, p: integer;
    
    begin
      WriteLn('Введите кол-во строк');
      Readln(k);
      WriteLn('Введите кол-во столбцов');
      Readln(n);
      //Ввод массива, подсчет минимальной суммы в четных строках (сумма четной строки записывается в конец строки) и нахождение минимальной суммы
      for i := 1 to k do
      begin
        sum := 0;
        for j := 1 to n do 
        begin
          Write('a[', i, ',', j, ']=');
          Readln(a[i, j]);
          if (i mod 2 = 0) then sum := sum + a[i, j];
          
          if (i mod 2 = 0) and (j = n) then 
          begin
            if(i = 2) then minsum := sum;
            a[i, j + 1] := sum;
            if(sum < minsum) then minsum := sum;
          end;
          
        end;
      end;
      for i := 1 to k do
      begin
      currentPos := 1;
        for j := 1 to n do 
        begin
          if(i mod 2 = 0) then
          //Положительные перемещаем в начало
          begin
            if (a[i, n + 1] = minsum) and (a[i, j] > 0) then 
            begin
              //Запоминаем положительный элемент
              p := a[i, j];
              //Сдвиг вправо
              for j1 := j downto currentPos + 1 do
              begin
                a[i,j1] := a[i, j1 - 1];
              end;
              a[i, currentPos] := p;
              Inc(currentPos);
            end
          end
          else
          begin
            if(a[i, j] < 0) then a[i, j] := a[i, j] * 2;
          end;
        end;
      end;
      for i := 1 to k do 
      begin
        WriteLn();
        for j := 1 to n do
        begin
          Write(a[i, j], ' ');
        end;
      end;
      Writeln(minsum);
    end.
    
    
    • Public Snippets
    • Channels Snippets